home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / ead / ead02.dms / ead02.adf / AmigaBasicProgs / MigaSol (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-01-19  |  16KB  |  785 lines

  1. CLEAR, 40960
  2. DEFINT a-z 
  3. OPTION BASE 1
  4. DIM deck(52),upcp(7,12),downcp(7,6),cpndx(7,2),ap(4,12) 'card pile arrays
  5. DIM suit(21,4), cardval(21,13), card(99,52) 'card graphics arrays
  6. DIM topdeck(2), temp(2,2), drawdeck(24), playdeck(24) 
  7. GOTO Begin
  8.  
  9. 'MigaSol version 1.0
  10. 'Copyright 1986, Jon Scarpelli. All rights reserved.
  11. 'The author retains all rights to this software and
  12. 'hereby grants license for the free dissemination
  13. 'of this software product for non-commercial use only
  14. 'under the sole condition that this notice not be
  15. 'removed. The author reserves the right to revoke this
  16. 'license at any time.
  17. 'Now that that's done, this software is distributed as
  18. 'Shareware. If you find yourself using this software
  19. 'and would like to encourage both the Shareware concept
  20. 'and further development of this program, please send
  21. 'a contribution ($10 would be nice) to the author:
  22. '        Jon Scarpelli
  23. '        3209 Lindenwood
  24. '        Dearborn, MI  48120
  25. 'Planned enhancements include music, rules to reduce but
  26. 'not eliminate cheating, score keeping, and an UNDO
  27. 'function. Your comments and suggestions will be 
  28. 'appreciated. ENJOY THIS!
  29.  
  30. Begin:
  31.       
  32. GOSUB GetGraphics
  33. GOSUB StartGame
  34.  
  35. LOCATE 16,3:PRINT "HELP"
  36. LOCATE 18,3:PRINT "PLAY  "
  37.  
  38. HelpOrPlay:
  39.  
  40. WHILE MOUSE(0)<>1:WEND
  41. x=MOUSE(3):y=MOUSE(4)  
  42.  
  43. IF x>16 AND x<48 AND y>120 AND y<129 THEN
  44.   HelpNeeded=-1
  45. END IF
  46.  
  47. IF HelpNeeded THEN
  48.   GOSUB PlayInstructions
  49.   GOTO CheckMouse  
  50. ELSE
  51.   LOCATE 16,3:PRINT "Have at it!  "
  52.   LOCATE 18,3:PRINT "REDEAL"
  53.   GOTO CheckMouse
  54. END IF
  55.  
  56. CheckMouse:
  57.  
  58. WHILE MOUSE(0)<>1:WEND
  59. x=MOUSE(3):y=MOUSE(4)  
  60.  
  61. ProcessSelection:
  62.  
  63. LOCATE 2,3
  64. PRINT "Wait..."
  65. LOCATE 3,3
  66. PRINT "       "
  67. LOCATE 16,3
  68. PRINT "             "
  69.  
  70. IF x>16 AND x<56 AND y>152 AND y<161 THEN
  71.   IF click=frompos THEN
  72.     Oops=-1:click=newpos
  73.     GOTO ShowSelect
  74.   ELSE
  75.     LOCATE 16,3:PRINT "Too late...  "
  76.   END IF  
  77. ELSEIF x>16 AND x<64 AND y>136 AND y<145 THEN
  78.   redeal=-1
  79.   GOSUB StartGame
  80.   GOTO CheckMouse
  81. ELSE      
  82.   click=click*-1
  83. END IF
  84.  
  85. IF click=frompos THEN
  86.   fromcardpile=0:fromplaypile=0
  87.   tocardpile=0:newpile=0
  88. END IF
  89.   
  90. GOSUB TestPile
  91. IF UsingCardpile THEN
  92.  IF cpndx(pile,up)>0 THEN  'up card available
  93.   GOSUB TestUpCard    'was card picked available & get y positions
  94.   IF validcard THEN
  95.     IF click=frompos THEN
  96.       fromx1=x1:fromy1=y1
  97.       fromx2=x2:fromy2=y2
  98.       fromcard=card:frompile=pile
  99.       fromupndx=cpndx(pile,up)
  100.       fromdownndx=cpndx(pile,down)
  101.       cardstomove=fromupndx-card+1
  102.       fromcardpile=-1
  103.     ELSE  'click=newpos
  104.       tocardpile=-1
  105.       newx1=x1:newy1=y1
  106.       newx2=x2:newy2=y2
  107.       newcard=card:newpile=pile
  108.       newupndx=cpndx(newpile,up)
  109.       IF fromcardpile THEN
  110.         GOSUB UpdateArrays
  111.         IF OkToMove THEN
  112.           GOSUB MoveCard
  113.         END IF
  114.       ELSE
  115.         GOSUB UsePlayPile
  116.       END IF
  117.     END IF
  118.   ELSE
  119.     click=click*-1
  120.   END IF
  121.  ELSEIF cpndx(pile,down)>0 THEN  'down card available
  122.        GOSUB TestDownCard
  123.        IF validcard THEN
  124.          IF click=frompos THEN     'turn card over
  125.            CurrentCard=downcp(pile,1)
  126.            PUT (x1,y1),card(1,CurrentCard),PSET
  127.            IF cpndx(pile,down)>1 THEN
  128.              FOR i=1 TO 5
  129.                downcp(pile,i)=downcp(pile,i+1)
  130.              NEXT i
  131.            END IF
  132.            cpndx(pile,up)=1
  133.            cpndx(pile,down)=cpndx(pile,down)-1
  134.            cpndx(pile,up)=1
  135.            upcp(pile,1)=CurrentCard
  136.            click=click*-1
  137.          END IF
  138.        ELSE
  139.          click=click*-1
  140.        END IF
  141.      ELSE      'empty pile
  142.        IF click=newpos THEN
  143.          newcard=1:newpile=pile
  144.          newy1=5:newx1=x1:newupndx=0
  145.          IF fromcardpile THEN
  146.            GOSUB UpdateArrays
  147.            IF OkToMove THEN
  148.              GOSUB MoveCard
  149.            END IF
  150.          ELSE
  151.            tocardpile=-1
  152.            GOSUB UsePlayPile
  153.          END IF
  154.        ELSE
  155.          LOCATE 16,3 
  156.          PRINT "Not today... "
  157.          click=click*-1
  158.        END IF
  159.      END IF
  160. ELSEIF ace1pile OR ace2pile OR ace3pile OR ace4pile THEN
  161.        IF click=newpos THEN
  162.          newx1=580:newcard=1
  163.          IF ace1pile THEN
  164.            newpile=1:newy1=35
  165.          ELSEIF ace2pile THEN
  166.                newpile=2:newy1=70
  167.          ELSEIF ace3pile THEN
  168.                newpile=3:newy1=105
  169.          ELSE
  170.                newpile=4:newy1=140
  171.          END IF
  172.         
  173.          GOSUB UpdateAceArray
  174.          IF OkToMove THEN
  175.            IF fromplaypile THEN
  176.              GOSUB UsePlayPile
  177.            ELSE
  178.              GOSUB MoveCard
  179.            END IF
  180.          END IF
  181.        END IF  
  182.      ELSEIF UsingDrawpile THEN
  183.        GOSUB UseDrawPile
  184.        click=newpos
  185.      ELSEIF UsingPlaypile AND cardtoplay>0 THEN
  186.        GOSUB UsePlayPile
  187.      ELSE
  188.        click=click*-1
  189.      END IF
  190.  
  191. ShowSelect:
  192.  
  193. Oops=0
  194.  
  195. LOCATE 2,3
  196. PRINT "Select "
  197.  
  198. LOCATE 3,3
  199. IF click=frompos THEN
  200.   PRINT "To...  "
  201. ELSE
  202.   PRINT "From..."
  203. END IF
  204.   
  205. GOTO CheckMouse
  206.  
  207.  
  208. TestPile:
  209.  
  210.   UsingCardpile=0:pile=0
  211.   UsingDrawpile=0:UsingPlaypile=0
  212.   ace1pile=0:ace2pile=0
  213.   ace3pile=0:ace4pile=0
  214.   IF y>4 AND y<161 AND x>131 AND x<549 THEN
  215.     IF x>131 AND x<164 THEN
  216.         pile=1:UsingCardpile=-1
  217.         x1=132:x2=163
  218.     ELSEIF x>195 AND x<228 THEN
  219.         pile=2:UsingCardpile=-1
  220.         x1=196:x2=227
  221.     ELSEIF x>259 AND x< 292 THEN
  222.         pile=3:UsingCardpile=-1
  223.         x1=260:x2=291
  224.     ELSEIF x>323 AND x<356 THEN
  225.         pile=4:UsingCardpile=-1
  226.         x1=324:x2=355
  227.     ELSEIF x>387 AND x<420 THEN
  228.         pile=5:UsingCardpile=-1
  229.         x1=388:x2=419
  230.     ELSEIF x>451 AND x< 484 THEN
  231.         pile=6:UsingCardpile=-1
  232.         x1=452:x2=483
  233.     ELSEIF x>515 AND x<548 THEN
  234.         pile=7:UsingCardpile=-1
  235.         x1=516:x2=547
  236.     ELSE
  237.         LOCATE 16,3
  238.         PRINT "Which pile?  "
  239.     END IF
  240.   ELSEIF x>19 AND x<52 AND y>39 AND y<64 THEN  
  241.         UsingPlaypile=-1
  242.         x1=20:y1=40:x2=51:y2=63
  243.    ELSEIF x>19 AND x<52 AND y>79 AND y<104 THEN
  244.         UsingDrawpile=-1
  245.    ELSEIF x>579 AND x<612 AND click=newpos THEN
  246.       x1=580:x2=611
  247.       IF y>34 AND y<59 THEN 
  248.         ace1pile=-1 '1st ace pile
  249.         y1=35:y2=58 
  250.       ELSEIF y>69 AND y<94 THEN
  251.         ace2pile=-1 '2nd ace pile, etc.
  252.         y1=70:y2=93 
  253.       ELSEIF y>104 AND y<129 THEN
  254.         ace3pile=-1
  255.         y1=105:y2=128 
  256.       ELSEIF y>139 AND y<164 THEN
  257.         ace4pile=-1
  258.         y1=140:y2=163
  259.       ELSE
  260.         LOCATE 16,3
  261.         PRINT "How's that?  "
  262.       END IF
  263.     ELSE
  264.       LOCATE 16,3
  265.       PRINT "Whuh..??     " 
  266.     END IF
  267.  
  268. RETURN
  269.       
  270. TestUpCard:
  271.              
  272.   card=0:validcard=0
  273.  
  274.   IF y>4 AND y<161 THEN card=INT((y-5)/12)+1
  275.     
  276.   IF card<=cpndx(pile,up) THEN      'pointing to top half
  277.     validcard=-1                    'of any up card
  278.   ELSEIF card-1=cpndx(pile,up) THEN   'pointing to bottom
  279.         card=card-1                   'half of last up card
  280.         validcard=-1
  281.   ELSE
  282.     LOCATE 16,3:PRINT "Which card?  "      
  283.   END IF
  284.  
  285. 'Get y1 and y2 position
  286.  
  287.   IF validcard THEN      'card <= cpndx
  288.     y1=5+(card-1)*12
  289.     y2=5+(cpndx(pile,up)+1)*12
  290.   END IF
  291.       
  292. RETURN
  293.  
  294. TestDownCard:
  295.              
  296.   card=0:validcard=0
  297.  
  298.   IF y>4 AND y<161 THEN card=INT((y-5)/12)+1
  299.   
  300.   IF card=1 OR card=2 THEN
  301.     card=1
  302.     y1=5
  303.     validcard=-1
  304.   ELSE
  305.     LOCATE 16,3:PRINT "Come again?  "
  306.   END IF
  307.  
  308. RETURN
  309.  
  310. UpdateArrays:
  311.  
  312.   OkToMove=0 
  313.  
  314.   IF frompile<>newpile THEN
  315.     GOSUB FromPileRedraw  
  316.     j=1    
  317.     IF newupndx>0 THEN  'cards already showing
  318.       newy1=newy1+12    'offset so as not to cover
  319.     END IF  
  320.     FOR i=fromcard TO fromcard+cardstomove-1
  321.       upcp(newpile,newupndx+j)=upcp(frompile,i)
  322.       upcp(frompile,i)=0
  323.       j=j+1
  324.     NEXT i     
  325.     cpndx(frompile,up)=fromupndx-cardstomove
  326.     cpndx(newpile,up)=newupndx+cardstomove
  327.     OkToMove=-1
  328.   ELSE
  329.     LOCATE 16,3
  330.     PRINT "Nope...      "
  331.   END IF
  332.     
  333. RETURN
  334.  
  335.  
  336. UpdateAceArray:
  337.  
  338.   OkToMove=0
  339.  
  340.   IF fromcardpile THEN
  341.     CurrentCard=upcp(frompile,fromcard)
  342.   ELSE
  343.     CurrentCard=playdeck(cardtoplay)
  344.   END IF
  345.      
  346.   IF ap(newpile,1)>0 THEN 'not 1st card on pile
  347.     IF CurrentCard=ap(newpile,1)+1 THEN  'consequtive cards
  348.       IF fromcardpile THEN
  349.         GOSUB FromPileRedraw
  350.         upcp(frompile,fromcard)=0     
  351.         cpndx(frompile,up)=fromupndx-1  
  352.       END IF  
  353.       newx1=580:newcard=1
  354.       FOR i=1 TO 11
  355.         ap(newpile,i+1)=ap(newpile,i)
  356.       NEXT i
  357.       ap(newpile,1)=CurrentCard
  358.       OkToMove=-1
  359.     ELSE
  360.       LOCATE 16,3
  361.       PRINT "Can't do that"
  362.     END IF
  363.   ELSEIF CurrentCard=1 OR CurrentCard=14 OR CurrentCard=27 OR CurrentCard=40 THEN
  364.         IF fromcardpile THEN
  365.           GOSUB FromPileRedraw
  366.           upcp(frompile,fromcard)=0    
  367.           cpndx(frompile,up)=fromupndx-1
  368.         END IF
  369.         newx1=580:newcard=1
  370.         ap(newpile,1)=CurrentCard
  371.         OkToMove=-1
  372.       ELSE
  373.         LOCATE 16,3
  374.         PRINT "Can't do that"
  375.       END IF
  376.       
  377. RETURN
  378.  
  379. FromPileRedraw:
  380.  
  381.  
  382.   DrawEmptyPile=0:DrawCardBack=0
  383.   
  384.   IF fromcard=1 THEN   '1st card moving
  385.     IF fromdownndx>0 THEN  'down cards available
  386.       DrawCardBack=-1           
  387.     ELSE
  388.       DrawEmptyPile=-1
  389.     END IF
  390.   ELSE
  391.     CardToRedraw=upcp(frompile,fromcard-1)
  392.   END IF
  393.  
  394. RETURN
  395.  
  396. MoveCard:
  397.  
  398.   ERASE temp
  399.   arraysize=3+INT((16+fromx2-fromx1)/16)*(1+fromy2-fromy1)*2
  400.   DIM temp(arraysize,2)
  401.   GET (fromx1,fromy1)-(fromx2,fromy2),temp(1,1)  ' cards
  402.   GET (fromx1-32,fromy1)-(fromx2-32,fromy2),temp(1,2)  'clear background
  403.   PUT (fromx1,fromy1),temp(1,2),PSET 'clear fromcards
  404.   'put bottom half of card left or empty pile or back of down card
  405.   IF DrawEmptyPile THEN
  406.     LINE (fromx1,fromy1)-(fromx1+31,fromy1+23),1,b
  407.     DrawEmptyPile=0
  408.   ELSEIF DrawCardBack THEN
  409.         PATTERN ,topdeck
  410.         COLOR 3,2
  411.         LINE (fromx1,fromy1)-(fromx1+31,fromy1+23),,bf
  412.         DrawCardBack=0
  413.       ELSE
  414.         PUT (fromx1,fromy1-12),card(1,CardToRedraw),PSET
  415.       END IF
  416.                              
  417.   PUT (newx1,newy1),temp(1,1),PSET  
  418.   
  419. RETURN
  420.  
  421. UseDrawPile:
  422.  
  423.   IF click = frompos THEN
  424.     IF cardsdealt < cardstodeal THEN
  425.       IF cardsdealt < cardstodeal-2 THEN
  426.         FOR i=1 TO 3
  427.           playdeck(cardtoplay+i)=drawdeck(cardsdealt+i)
  428.         NEXT i
  429.         cardtoplay=cardtoplay+3
  430.         cardsdealt=cardsdealt+3
  431.       ELSEIF cardsdealt=cardstodeal-2 THEN
  432.         playdeck(cardtoplay+1)=drawdeck(cardsdealt+1)
  433.         playdeck(cardtoplay+2)=drawdeck(cardsdealt+2)
  434.         cardtoplay=cardtoplay+2
  435.         cardsdealt=cardsdealt+2
  436.       ELSEIF cardsdealt=cardstodeal-1 THEN
  437.         playdeck(cardtoplay+1)=drawdeck(cardsdealt+1)
  438.         cardtoplay=cardtoplay+1
  439.         cardsdealt=cardsdealt+1
  440.       END IF
  441.       newx1=20:newy1=40 'playpile coords
  442.       CurrentCard=playdeck(cardtoplay) 'get current card to play
  443.       PUT (newx1,newy1),card(1,CurrentCard),PSET 'show current card
  444.       IF cardsdealt = cardstodeal THEN 'draw empty draw pile
  445.         ERASE temp
  446.         DIM temp(99,2)
  447.         GET (60,162)-(91,185),temp(1,2) 'get empty background
  448.         PUT (20,80),temp(1,2),PSET 'clear draw deck
  449.         LINE (20,80)-(51,103),1,b 'draw empty pile
  450.       END IF
  451.     ELSE  'empty draw pile
  452.       FOR i=1 TO cardstodeal-cardsplayed 'move play pile to draw pile
  453.         drawdeck(i) = playdeck(i)
  454.       NEXT i
  455.       cardstodeal = cardstodeal-cardsplayed
  456.       cardsplayed=0:cardtoplay=0:cardsdealt=0
  457.       IF cardstodeal>0 THEN 
  458.         ERASE temp
  459.         DIM temp( 99,2)
  460.         GET (60,162)-(91,185),temp(1,2) 'get empty background
  461.         PUT (20,40),temp(1,2),PSET 'clear play deck
  462.         LINE (20,40)-(51,63),1,b 'draw empty pile      
  463.         PATTERN ,topdeck
  464.         COLOR 3,2
  465.         LINE (20,80)-(51,103),,bf
  466.       END IF
  467.     END IF
  468.   END IF
  469.  
  470. RETURN
  471.  
  472. UsePlayPile:
  473.  
  474.   IF cardtoplay > 0 THEN
  475.     IF click = frompos THEN
  476.       fromx1=x1:fromx2=x2
  477.       fromy1=y1:fromy2=y2
  478.       validcard=-1:fromplaypile=-1
  479.       fromcardpile=0
  480.     ELSE  'click=newpos        
  481.       CurrentCard=playdeck(cardtoplay)
  482.       cardsplayed=cardsplayed+1
  483.       cardtoplay=cardtoplay-1
  484.       IF cardtoplay=0 THEN
  485.         DrawEmptyPile=-1
  486.       ELSE
  487.         CardToRedraw=playdeck(cardtoplay)
  488.       END IF
  489.       IF tocardpile THEN
  490.         IF newupndx > 0 THEN
  491.           newy1=newy1+12
  492.         END IF
  493.         upcp(newpile,newupndx+1)=CurrentCard
  494.         cpndx(newpile,up)=newupndx+1
  495.       END IF
  496.       ERASE temp
  497.       DIM temp(99,2)
  498.       GET (fromx1,fromy1)-(fromx2,fromy2),temp(1,1)
  499.       PUT (newx1,newy1),temp(1,1),PSET
  500.       IF NOT DrawEmptyPile THEN
  501.         PUT (fromx1,fromy1),card(1,CardToRedraw),PSET
  502.       ELSE
  503.         GET (60,162)-(91,185),temp(1,2) 'get empty background
  504.         PUT (fromx1,fromy1),temp(1,2),PSET 'clear play deck
  505.         LINE (fromx1,fromy1)-(fromx2,fromy2),1,b
  506.         DrawEmptyPile=0
  507.       END IF
  508.       
  509.       OkToMove=-1
  510.     END IF
  511.   END IF
  512.  
  513. RETURN  
  514.       
  515. StartGame:
  516.   up=1:down=2
  517.   frompos=-1:newpos=1:click=newpos:redeal=0
  518.   cardstodeal=24:cardsdealt=0:cardtoplay=0
  519.   cardsplayed=0
  520.   COLOR 1,0
  521. InitArrays:
  522.   FOR card=1 TO 52
  523.     deck(card)=card
  524.   NEXT card
  525.  
  526.   FOR pile=1 TO 7
  527.     cpndx(pile,up)=1
  528.     cpndx(pile,down)=pile-1
  529.   NEXT pile
  530.   
  531.   FOR pile=1 TO 4 
  532.     FOR card=1 TO 12
  533.       ap(pile,card)=0
  534.     NEXT card
  535.   NEXT pile
  536.   
  537.   FOR card=1 TO 24
  538.     playdeck(card)=0
  539.     drawdeck(card)=0
  540.   NEXT card
  541.   
  542.   FOR pile=1 TO 7
  543.     FOR card=1 TO 12
  544.       upcp(pile,card)=0
  545.     NEXT card
  546.   NEXT pile
  547.  
  548.   FOR pile=1 TO 7
  549.     FOR card=1 TO 6
  550.       downcp(pile,card)=0
  551.     NEXT card
  552.   NEXT pile  
  553.   
  554.   RANDOMIZE  TIMER
  555.   played=1
  556.   
  557. Gencards:
  558.  
  559.   FOR i=1 TO 52
  560.     x=INT(RND*52+1)
  561.     SWAP deck(i),deck(x)
  562.   NEXT i
  563.  
  564. DealCards:
  565.   played=0
  566.   FOR card=1 TO 7
  567.     FOR pile = card TO 7  
  568.       played=played+1
  569.       IF card=1 THEN
  570.         upcp(pile,card)=deck(played)
  571.       ELSE
  572.         downcp(pile,card-1)=deck(played)
  573.       END IF
  574.     NEXT pile  
  575.   NEXT card 
  576.            
  577. BuildDrawDeck:
  578.  
  579.   FOR i=29 TO 52
  580.     j=i-28
  581.     drawdeck(j)=deck(i)
  582.   NEXT i
  583.  
  584. TurnPiles:
  585.   CLS
  586.   COLOR 1,0
  587.    
  588.   FOR pile=1 TO 7        ' card piles
  589.     CurrentCard=upcp(pile,1)   
  590.     x=132+((pile-1)*64)
  591.     y=5 
  592.     PUT (x,y),card(1,CurrentCard),PSET 
  593.    NEXT pile
  594.  
  595.   FOR pile=1 TO 4     ' empty ace piles
  596.     x=580
  597.     y=35*pile
  598.     LINE (x,y)-(x+31,y+23),1,b
  599.   NEXT pile
  600.  
  601. ' create empty play pile and draw pile 
  602.   x=20
  603.   y=40
  604.   LINE (x,y)-(x+31,y+23),1,b
  605.   x=20
  606.   y=80
  607.   PATTERN ,topdeck
  608.   COLOR 3,2       
  609.   LINE (x,y)-(x+31,y+23),,bf
  610.    x=1:y=1
  611.   
  612.   LOCATE 18,3
  613.   PRINT "REDEAL"
  614.  
  615.   LOCATE 20,3
  616.   PRINT "Oops!"
  617.   
  618.   LOCATE 2,3
  619.   PRINT "Select "
  620.   LOCATE 3,3
  621.   PRINT "From..."
  622.  
  623. RETURN
  624.  
  625.     
  626. GetGraphics:
  627.  
  628.   'load 1st 3 words of each array
  629.   FOR i=1 TO 4
  630.     suit (1,i)=16
  631.     suit (2,i)=9
  632.     suit (3,i)=2
  633.   NEXT i
  634.  
  635.   FOR i=1 TO 13
  636.     cardval (1,i)=16
  637.     cardval (2,i)=9
  638.     cardval (3,i)=2
  639.   NEXT i
  640.  
  641.   FOR i=1 TO 52
  642.     card (1,i)=32
  643.     card (2,i)=24
  644.     card (3,i)=2
  645.   NEXT i
  646.  
  647.   FOR j=1 TO 4
  648.     FOR i=4 TO 12
  649.       READ suit(i,j)
  650.     NEXT i
  651.   NEXT j   
  652.  
  653.   FOR j=13 TO 1 STEP -1
  654.     FOR i=4 TO 12
  655.       READ  cardval(i,j)
  656.     NEXT i
  657.   NEXT j  
  658.  
  659.  
  660.   READ topdeck(1):READ topdeck(2)
  661.   
  662.   k=1
  663.   PRINT "Please wait while I print a new deck for you..."
  664.   FOR  i=1 TO 4
  665.     FOR j=1 TO 13
  666.       LINE (16,59)-(47,82),1,bf 
  667.       PUT (16,60),cardval(1,j) 
  668.       PUT (32,60),suit(1,i) 
  669.       IF i=1 OR i=3 THEN suitcolor=2 :ELSE suitcolor=3       
  670.       PAINT (40,64),suitcolor,1
  671.       IF j <> 10 AND j <> 13 THEN PAINT (24,60),suitcolor,1 
  672.         IF j=10 THEN PAINT (24,60),suitcolor,1: PAINT (18,60),suitcolor,1
  673.         IF j=13 THEN PAINT (20,60),suitcolor,1               
  674.         GET (16,59)-(47,82),card(1,k)
  675.       k=k+1
  676.     NEXT j 
  677.   NEXT i 
  678. RETURN
  679.  
  680. PlayInstructions:
  681.  
  682.   LOCATE 5,38:PRINT "CARD PILES"
  683.   LOCATE 6,9:PRINT "PLAY"
  684.   LOCATE 6,67:PRINT "ACES"
  685.   LOCATE 11,9:PRINT "DRAW"
  686.   LOCATE 16,3:PRINT "    "
  687.   LOCATE 18,3:PRINT "PLAY"
  688.   COLOR 1,0
  689.   LOCATE 7,15
  690.   PRINT "1 Cards are moved (3 at a time) from the draw pile"
  691.   LOCATE 8,15
  692.   PRINT "  to the play pile by clicking once on the draw pile."
  693.   LOCATE 9,15
  694.   PRINT "2 A checkered design indicates that a card is face" 
  695.   LOCATE 10,15
  696.   PRINT "  down on the pile, ready for play. Down cards are"
  697.   LOCATE 11,15
  698.   PRINT "  turned up by clicking once on the down card."
  699.   LOCATE 12,15
  700.   PRINT "3 Cards are moved from the play pile and card piles to"
  701.   LOCATE 13,15
  702.   PRINT "  the card piles and ace piles by clicking once on the"
  703.   LOCATE 14,15
  704.   PRINT "  card to be moved (Select From) and then clicking once"
  705.   LOCATE 15,15
  706.   PRINT "  on the card position to move to (Select To)."
  707.   LOCATE 16,15
  708.   PRINT "4 One-click the empty draw pile to recycle the play pile."  
  709.   LOCATE 17,15
  710.   PRINT "5 Watch the Select box. It tells you what action is "
  711.   LOCATE 18,15
  712.   PRINT "  expected. If you click on a card and see no response in"
  713.   LOCATE 19,15
  714.   PRINT "  the Select box, wait one full second, then click on the"
  715.   LOCATE 20,15
  716.   PRINT "  card indicated in the Select box."
  717.   LOCATE 21,15
  718.   PRINT "6 Oops! will change Select To... to Select From..." 
  719.   LOCATE 22,15
  720.   PRINT "7 This game will allow you to cheat and win.   Good luck."
  721.   COLOR 3,2
  722.   HelpNeeded=0:redeal=-1
  723. RETURN
  724.   
  725. 'club data
  726. DATA &h0180,&h07e0,&h07e0,&h03c0
  727. DATA &h1ff8,&h3ffc,&h3ffc,&h1db8,&h0180
  728. 'heart data
  729. DATA &h0e38,&h1f7c,&h1ffc,&h1ffc
  730. DATA &h1ffc,&h0ff8,&h07f0,&h01c0,&h0080
  731. 'spade data
  732. DATA &h0180,&h03c0,&h07e0,&h0ff0
  733. DATA &h1ff8,&h1ff8,&h1db8,&h0180,&h0180
  734. 'diamond data
  735. DATA &h0380,&h07c0,&h0fe0,&h3ff8
  736. DATA &h7ffc,&h3ff8,&h0fe0,&h07c0,&h0380
  737. 'king data
  738. DATA &h1c38,&h0c30,&h0c60,&h0ce0
  739. DATA &h0fc0,&h0c60,&h0c70,&h0c30,&h1c38
  740. 'queen data
  741. DATA &h07c0,&h1c70,&h3838,&h3838
  742. DATA &h3838,&h39b8,&h39b8,&h1cfc,&h07ce
  743. 'jack data
  744. DATA &h07f8,&h00e0,&h00e0,&h00e0
  745. DATA &h00e0,&h00e0,&h38e0,&h38e0,&h1fc0
  746. '10 data
  747. DATA &h31fc,&h738e,&h7306,&h3306
  748. DATA &h3306,&h3306,&h3306,&h338e,&h79fc
  749. '9 data
  750. DATA &h07f0,&h0e38,&h0e38,&h0e38
  751. DATA &h07f8,&h0038,&h0e38,&h0770,&h03e0
  752. '8 data
  753. DATA &h07f0,&h1e3c,&h1c1c,&h1e3c
  754. DATA &h07f0,&h1e3c,&h1c1c,&h1e3c,&h07f0
  755. '7 data 
  756. DATA &h1ffc,&h1c1c,&h0038,&h0070
  757. DATA &h00e0,&h01c0,&h0380,&h0380,&h0380
  758. '6 data
  759. DATA &h07e0,&h0e00,&h1c00,&h1c00
  760. DATA &h1ff0,&h1c38,&h1c38,&h0e38,&h07f0
  761. '5 data
  762. DATA &h1ff0,&h1c00,&h1c00,&h1ff0
  763. DATA &h0038,&h001c,&h1c1c,&h0e38,&h07f0
  764. '4 data
  765. DATA &h00f8,&h01f8,&h03b8,&h0738
  766. DATA &h0e38,&h1c38,&h1ffc,&h0038,&h0038
  767. '3 data
  768. DATA &h1ffc,&h001c,&h0038,&h03f0
  769. DATA &h0038,&h001c,&h301c,&h1838,&h0ff0
  770. '2 data
  771. DATA &h0ff8,&h1e1c,&h1c1c,&h003c
  772. DATA &h07f8,&h1f00,&h1c00,&h1c00,&h1ff8
  773. 'ace data
  774. DATA &h01c0,&h03e0,&h0770,&h0e38
  775. DATA &h1c1c,&h1ffc,&h1c1c,&h1c1c,&h1c1c
  776.  
  777. 'topdeck data
  778. DATA &hf0f0,&h0f0f 
  779.  
  780.     
  781.   
  782.     
  783.   
  784.                 
  785.